home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir38 / vga_doc2.zip / SUPERVGA.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-02  |  39KB  |  1,548 lines
  1. unit supervga;
  2.  
  3. interface
  4. uses dos;
  5.  
  6. type
  7.   str10=string[10];
  8.  
  9.   mmods=(_text,
  10.          _text2,
  11.          _text4,
  12.          _pl2 ,   {plain mono, 8 pixels per byte}
  13.          _pl2e,   {mono odd/even, 8 pixels per byte, two planes}
  14.          _herc,   {Hercules mono, 4 "banks" of 8kbytes}
  15.          _cga2,   {CGA 2 color, 2 "banks" of 16kbytes}
  16.          _cga4,   {CGA 4 color, 2 "banks" of 16kbytes}
  17.          _pl4 ,   {4 color odd/even planes}
  18.          _pk4 ,   {4 color "packed" pixels 4 pixels per byte}
  19.          _pl16,   {std EGA/VGA 16 color: 4 planes, 8 pixels per byte}
  20.          _pk16,   {ATI mode 65h two 16 color pixels per byte}
  21.          _p256,   {one 256 color pixel per byte}
  22.          _p32k,   {Sierra 15 bit}
  23.          _p64k,   {Sierra 16bit/XGA}
  24.          _p16m);  {RGB 3bytes per pixel}
  25.  
  26.   modetype=record
  27.              md,xres,yres,bytes:word;
  28.              memmode:mmods;
  29.            end;
  30.  
  31.   CHIPS=(__EGA,__VGA,__chips451,__chips452,__chips453,__paradise,__video7
  32.         ,__tseng3,__tseng4,__tridBR,__tridCS,__trid89,__everex,__ati1,__ati2
  33.         ,__genoa,__oak,__cirrus,__aheadA,__aheadB,__ncr,__yamaha,__poach
  34.         ,__s3,__al2101,__acumos,__mxic,__vesa,__realtek,__p2000,__cirrus54
  35.         ,__none);
  36.  
  37.  
  38. const
  39.   colbits:array[mmods] of integer=
  40.                (0,0,0,1,1,1,1,2,2,2,4,4,8,15,16,24);
  41.   modecols:array[mmods] of longint=
  42.                (0,0,0,2,2,2,2,4,4,4,16,16,256,32768,65536,16777216);
  43.  
  44.   mdtxt:array[mmods] of string[210]=('Text','2 color Text','4 color Text'
  45.                 ,'Monochrome','2 colors planar','Hercules','CGA 2 color','CGA 4 color'
  46.                 ,'4 colors planar','4 colors packed','16 colors planar','16 colors packed'
  47.                 ,'256 colors packed','32768 colors','65536 colors'
  48.                 ,'16777216 colors');
  49.  
  50.   mmodenames:array[mmods] of string[4]=('TXT ','TXT2','TXT4','PL2 ','PL2E','HERC'
  51.               ,'CGA2','CGA4','PL4 ','PK4 ','PL16','PK16','P256','P32K','P64K','P16M');
  52.  
  53.  
  54.   header:array[CHIPS] of string[14]=
  55.          ('EGA','VGA','Chips&Tech','Chips&Tech','Chips&Tech'
  56.          ,'Paradise','Video7','ET3000','ET4000'
  57.          ,'Trident','Trident','Trident','Everex','ATI','ATI'
  58.          ,'Genoa','Oak','Cirrus','Ahead','Ahead','NCR'
  59.          ,'Yamaha','Poach','S3','AL2101','Acumos','MXIC'
  60.          ,'VESA','Realtek','PRIMUS','Cirrus54','');
  61.  
  62.  
  63.   novgamodes=10;
  64.   stdmodetbl:array[1..novgamodes] of modetype=
  65.             ((md: 4;xres:320;yres:200;bytes: 80;memmode:_cga4)
  66.             ,(md: 5;xres:320;yres:200;bytes: 80;memmode:_cga4)
  67.             ,(md: 6;xres:640;yres:200;bytes: 80;memmode:_cga2)
  68.             ,(md:13;xres:320;yres:200;bytes: 40;memmode:_pl16)
  69.             ,(md:14;xres:640;yres:200;bytes: 80;memmode:_pl16)
  70.             ,(md:15;xres:640;yres:350;bytes: 80;memmode:_pl2)
  71.             ,(md:16;xres:640;yres:350;bytes: 80;memmode:_pl16)
  72.             ,(md:17;xres:640;yres:480;bytes: 80;memmode:_pl2)
  73.             ,(md:18;xres:640;yres:480;bytes: 80;memmode:_pl16)
  74.             ,(md:19;xres:320;yres:200;bytes:320;memmode:_p256));
  75.  
  76.  
  77.  
  78.   _dac0     =0;   {No DAC (MDA/CGA/EGA ..}
  79.   _dac8     =1;   {Std VGA DAC 256 cols.}
  80.   _dac15    =2;   {Sierra 32k DAC}
  81.   _dac16    =3;   {Sierra 64k DAC}
  82.   _dacss24  =4;   {Sierra?? 24bit RGB DAC}
  83.   _dacatt   =5;   {ATT 20c491/2  15/16/24 bit DAC}
  84.   _dacADAC1 =6;   {Acumos ADAC1  15/16/24 bit DAC}
  85.  
  86.  
  87.  
  88.  
  89.   vesa:word=0;
  90.  
  91.  
  92.  
  93. var
  94.   rp:registers;
  95.  
  96.   memmode:mmods;   {current memory mode}
  97.   vseg:word;       {Video buffer base segment}
  98.   video:string[5];
  99.   mm:word;         {Video memory in kilobytes}
  100.   CHIP:CHIPS;
  101.   dacname:string[20];
  102.   dactype:word;
  103.   crtc:word;       {I/O address of CRTC registers}
  104.   _crt:string[20];
  105.   secondary:string[20];
  106.   extra:string[80];
  107.   name:string[40];
  108.  
  109.   curmode:word;    {Current mode number}
  110.   pixels:word;     {Pixels in a scanline in current mode}
  111.   lins:word;       {lines in current mode}
  112.   bytes:longint;   {bytes in a scanline}
  113.   planes:word;     {number of video planes}
  114.  
  115.  
  116.   nomodes:word;
  117.   modetbl:array[1..30] of modetype;
  118.  
  119.  
  120.   vesarec:record
  121.             attr:word;
  122.             wina,winb:byte;
  123.             gran,winsiz,sega,segb:word;
  124.             pagefunc:pointer;
  125.             bytes,width,height:word;
  126.             charw,charh,planes,bits,nbanks,model,banks:byte;
  127.             x:array[byte] of byte;    {might get trashed by 4F01h}
  128.           end;
  129.  
  130.  
  131.   dotest:array[CHIPS] of boolean;
  132.  
  133.  
  134.  
  135.  
  136.  
  137. function strip(s:string):string;       {strip leading and trailing spaces}
  138. function upstr(s:string):string;       {convert a string to upper case}
  139. function istr(w:longint):str10;
  140. function hex2(w:word):str10;
  141. function hex4(w:word):str10;
  142.  
  143.  
  144. procedure vio(ax:word);         {INT 10h reg ax=AX. other reg. set from RP
  145.                                  on return rp.ax=reg AX}
  146.  
  147. function inp(reg:word):byte;     {Reads a byte from I/O port REG}
  148.  
  149. procedure outp(reg,val:word);    {Write the low byte of VAL to I/O port REG}
  150.  
  151. function rdinx(pt,inx:word):word;       {read register PT index INX}
  152.  
  153. procedure wrinx(pt,inx,val:word);       {write VAL to register PT index INX}
  154.  
  155. procedure modinx(pt,inx,mask,nwv:word);  {In register PT index INX sets
  156.                                           the bits in MASK as in NWV
  157.                                           the other are left unchanged}
  158.  
  159. procedure setbank(bank:word);
  160.  
  161. procedure setvstart(l:longint);       {Set the display start address}
  162.  
  163. function setmode(md:word):boolean;
  164.  
  165. procedure vesamodeinfo(md:word);
  166.  
  167. procedure dactocomm;
  168.  
  169. procedure dactopel;
  170.  
  171. procedure findvideo;
  172.  
  173.  
  174. implementation
  175.  
  176.  
  177. const
  178.   mmmask :array[0..8] of byte=(0,0,0,0,1,3,3,7,15);
  179.  
  180.   hx:array[0..15] of char='0123456789ABCDEF';
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187. var
  188.  
  189.   atireg:word;    {ATI extended registers}
  190.  
  191.   old,curbank:word;
  192.  
  193.   biosseg:word;
  194.   vgran:word;
  195.  
  196.  
  197.  
  198. function strip(s:string):string;       {strip leading and trailing spaces}
  199. begin
  200.   while s[length(s)]=' ' do dec(s[0]);
  201.   while copy(s,1,1)=' ' do delete(s,1,1);
  202.   strip:=s;
  203. end;
  204.  
  205. function upstr(s:string):string;       {convert a string to upper case}
  206. var x:word;
  207. begin
  208.   for x:=1 to length(s) do
  209.     s[x]:=upcase(s[x]);
  210.   upstr:=s;
  211. end;
  212.  
  213. function istr(w:longint):str10;
  214. var s:str10;
  215. begin
  216.   str(w,s);
  217.   istr:=s;
  218. end;
  219.  
  220. function hex2(w:word):str10;
  221. begin
  222.   hex2:=hx[(w shr 4) and 15]+hx[w and 15];
  223. end;
  224.  
  225. function hex4(w:word):str10;
  226. begin
  227.   hex4:=hex2(hi(w))+hex2(lo(w));
  228. end;
  229.  
  230.  
  231.  
  232. procedure vio(ax:word);         {INT 10h reg ax=AX. other reg. set from RP
  233.                                  on return rp.ax=reg AX}
  234. begin
  235.   rp.ax:=ax;
  236.   intr(16,rp);
  237. end;
  238.  
  239. function inp(reg:word):byte;     {Reads a byte from I/O port REG}
  240. begin
  241.   reg:=port[reg];
  242.   inp:=reg;
  243. end;
  244.  
  245. procedure outp(reg,val:word);    {Write the low byte of VAL to I/O port REG}
  246. begin
  247.   port[reg]:=val;
  248. end;
  249.  
  250.  
  251. function rdinx(pt,inx:word):word;       {read register PT index INX}
  252. var x:word;
  253. begin
  254.   if pt=$3C0 then x:=inp($3DA);    {If Attribute Register then reset Flip-Flop}
  255.   outp(pt,inx);
  256.   rdinx:=inp(pt+1);
  257. end;
  258.  
  259. procedure wrinx(pt,inx,val:word);       {write VAL to register PT index INX}
  260. begin
  261.   outp(pt,inx);
  262.   outp(pt+1,val);
  263. end;
  264.  
  265. procedure modinx(pt,inx,mask,nwv:word);  {In register PT index INX sets
  266.                                           the bits in MASK as in NWV
  267.                                           the other are left unchanged}
  268. var temp:word;
  269. begin
  270.   temp:=(rdinx(pt,inx) and not mask)+(nwv and mask);
  271.   wrinx(pt,inx,temp);
  272. end;
  273.  
  274.  
  275. function getbios(offs,lnn:word):string;
  276. var s:string;
  277. begin
  278.   s[0]:=chr(lnn);
  279.   move(mem[biosseg:offs],s[1],lnn);
  280.   getbios:=s;
  281. end;
  282.  
  283. function tstrg(pt,msk:word):boolean;       {Returns true if the bits in MSK
  284.                                             of register PT are read/writable}
  285. var old,nw1,nw2:word;
  286. begin
  287.   old:=inp(pt);
  288.   outp(pt,old and not msk);
  289.   nw1:=inp(pt) and msk;
  290.   outp(pt,old or msk);
  291.   nw2:=inp(pt) and msk;
  292.   outp(pt,old);
  293.   tstrg:=(nw1=0) and (nw2=msk);
  294. end;
  295.  
  296. function testinx2(pt,rg,msk:word):boolean;   {Returns true if the bits in MSK
  297.                                               of register PT index RG are
  298.                                               read/writable}
  299. var old,nw1,nw2:word;
  300. begin
  301.   old:=rdinx(pt,rg);
  302.   wrinx(pt,rg,old and not msk);
  303.   nw1:=rdinx(pt,rg) and msk;
  304.   wrinx(pt,rg,old or msk);
  305.   nw2:=rdinx(pt,rg) and msk;
  306.   wrinx(pt,rg,old);
  307.   testinx2:=(nw1=0) and (nw2=msk);
  308. end;
  309.  
  310. function testinx(pt,rg:word):boolean;     {Returns true if all bits of
  311.                                            register PT index RG are
  312.                                            read/writable.}
  313. var old,nw1,nw2:word;
  314. begin
  315.   testinx:=testinx2(pt,rg,$ff);
  316. end;
  317.  
  318. procedure dactopel;    {Force DAC back to PEL mode}
  319. begin
  320.   if inp($3c8)=0 then;
  321. end;
  322.  
  323. var
  324.   daccomm:word;
  325.  
  326. procedure dactocomm;    {Enter command mode of HiColor DACs}
  327. var x:word;
  328. begin
  329.   dactopel;
  330.   x:=inp($3c6);
  331.   x:=inp($3c6);
  332.   x:=inp($3c6);
  333.   daccomm:=inp($3c6);
  334. end;
  335.  
  336.  
  337.  
  338.  
  339.   (*  Set memory bank  *)
  340.  
  341. procedure setbank(bank:word);
  342. var x:word;
  343. begin
  344.   vseg:=$a000;
  345.   if bank=curbank then exit;   {Only set bank if diff. from current value}
  346.   case chip of
  347.     __acumos:modinx($3ce,9,$f0,bank shl 4);
  348.     __aheadA:begin
  349.                wrinx($3ce,13,bank shr 1);
  350.                x:=inp($3cc) and $df;
  351.                if odd(bank) then inc(x,32);
  352.                outp($3c2,x);
  353.              end;
  354.     __aheadB:wrinx($3ce,13,bank*17);
  355.     __al2101:outp($3d7,bank);
  356.       __ati1:modinx(atireg,$b2,$1e,bank shl 1);
  357.       __ati2:modinx(atireg,$b2,$ee,bank*$22);
  358.   __chips451:wrinx(crtc+2,11,bank);
  359.   __chips452:wrinx(crtc+2,16,bank shl 2);
  360.   __chips453:wrinx(crtc+2,16,bank shl 4);
  361.     __everex:begin
  362.                x:=inp($3cc) and $df;
  363.                if (bank and 2)>0 then inc(x,32);
  364.                outp($3c2,x);
  365.                modinx($3c4,8,$80,bank shl 7);
  366.              end;
  367.      __genoa:wrinx($3c4,6,bank*9+64);
  368.       __mxic:wrinx($3c4,$c5,bank*17);
  369.        __ncr:begin
  370.                if memmode<=_pl16 then bank:=bank shl 2;
  371.                wrinx($3c4,$18,bank shl 2);
  372.              end;
  373.        __oak:wrinx($3de,17,bank*17);
  374.   __paradise:wrinx($3ce,9,bank shl 4);
  375.  
  376.      __p2000,
  377.    __realtek:begin
  378.                outp($3d6,bank);
  379.                outp($3d7,bank);
  380.              end;
  381.         __s3:begin
  382.                wrinx(crtc,$38,$48);
  383.                modinx(crtc,$31,9,9);
  384.                if memmode=_pl16 then bank:=bank*4;
  385.                modinx(crtc,$35,$f,bank);
  386.                wrinx(crtc,$38,0);
  387.              end;
  388.     __tridBR:;
  389.     __tridCS,__poach,__trid89
  390.             :begin
  391.                wrinx($3c4,11,0);
  392.                if rdinx($3c4,11)=0 then;
  393.                modinx($3c4,14,$f,bank xor 2);
  394.              end;
  395.     __tseng3:outp($3cd,bank*9+64);
  396.     __tseng4:outp($3cd,bank*17);
  397.     __video7:begin
  398.                x:=inp($3cc) and $df;
  399.                if (bank and 2)>0 then inc(x,32);
  400.                outp($3c2,x);
  401.                modinx($3c4,$f9,1,bank);
  402.                modinx($3c4,$f6,$80,(bank shr 2)*5);
  403.  
  404.              end;
  405.   __cirrus54:wrinx($3CE,9,bank*16);
  406.       __vesa:begin
  407.                rp.bx:=0;
  408.                rp.dx:=bank*longint(64) div vgran;
  409.                vio($4f05);
  410.                rp.bx:=1;
  411.                vio($4f05);
  412.              end;
  413.   end;
  414.   curbank:=bank;
  415. end;
  416.  
  417.  
  418. procedure vesamodeinfo(md:word);
  419. begin
  420.   rp.cx:=md;
  421.   rp.es:=seg(vesarec);
  422.   rp.di:=ofs(vesarec);
  423.   vio($4f01);
  424.   vgran:=vesarec.gran;
  425.   bytes:=vesarec.bytes;
  426.   pixels:=vesarec.width;
  427.   lins:=vesarec.height;
  428.   case vesarec.bits of
  429.     4:memmode:=_pl16;
  430.     8:memmode:=_p256;
  431.    15:memmode:=_p32k;
  432.    16:memmode:=_p64k;
  433.    24:memmode:=_p16m;
  434.   end;
  435. end;
  436.  
  437. function safemode(md:word):boolean;
  438. var x,y:word;
  439. begin                 {Checks if we entered a Graph. mode}
  440.   vio(3);
  441.   vio(lo(md));
  442.   y:=rdinx($3ce,6);
  443.   safemode:=odd(y);
  444. end;
  445.  
  446. function tsvio(ax,bx:word):boolean;   {Tseng 4000 Hicolor mode set}
  447. begin
  448.   rp.bx:=bx;
  449.   vio(ax);
  450.   tsvio:=rp.ax=16;
  451. end;
  452.  
  453. function setmode(md:word):boolean;
  454. var x:word;
  455. begin
  456.   setmode:=true;
  457.   curmode:=md;
  458.   case chip of
  459. __ati1,__ati2:begin
  460.                 rp.bx:=$5506;
  461.                 rp.bp:=$ffff;
  462.                 rp.si:=0;
  463.                 vio($1200+md);
  464.                 if rp.bp=$ffff then setmode:=false
  465.                 else vio(md);
  466.               end;
  467.    __chips451:begin
  468.                 setmode:=safemode(md);
  469.                 x:=inp($46e8);
  470.                 outp($46e8,x or 16);
  471.                 outp($103,inp($103) or $80);
  472.                 outp($46e8,x and $ef);
  473.                 modinx(crtc+2,4,4,4);
  474.                 modinx(crtc+2,11,3,1);
  475.               end;
  476.    __chips452,__chips453:
  477.               begin
  478.                 setmode:=safemode(md);
  479.                 x:=inp($46e8);
  480.                 outp($46e8,x or 16);
  481.                 outp($103,inp($103) or $80);
  482.                 outp($46e8,x and $ef);
  483.                 modinx(crtc+2,4,4,4);
  484.                 modinx(crtc+2,11,3,1);
  485.                 wrinx(crtc+2,12,0);
  486.               end;
  487.      __everex:begin
  488.                 rp.bl:=md;
  489.                 vio($70);
  490.               end;
  491.    __paradise:begin
  492.                 setmode:=safemode(md);
  493.                 modinx($3ce,15,$17,5);
  494.                 wrinx(crtc,$29,$85);
  495.                 modinx($3ce,$b,8,0);
  496.                 modinx(crtc,$2f,$62,0);
  497.               end;
  498.         __ncr:begin
  499.                 setmode:=safemode(md);
  500.                 wrinx($3c4,5,5);
  501.                 wrinx($3c4,$18,0);
  502.                 wrinx($3c4,$19,0);
  503.                 wrinx($3c4,$1a,0);
  504.                 wrinx($3c4,$1b,0);
  505.  
  506.                 modinx($3c4,$1e,$1c,$18);
  507.               end;
  508.      __video7:begin
  509.                 rp.bl:=md;
  510.                 vio($6f05);
  511.               end;
  512.        __mxic:begin
  513.                 setmode:=safemode(md);
  514.                 wrinx($3c4,$a7,$87);    {enable extensions}
  515.               end;
  516.        __vesa:begin
  517.                 rp.bx:=md;
  518.                 vio($4f02);
  519.                 if rp.ax<>$4f then setmode:=false
  520.                 else begin
  521.                   vesamodeinfo(md);
  522.                   chip:=__vesa;
  523.                 end;
  524.               end;
  525.      __acumos:begin
  526.                 vio(md);
  527.                 wrinx($3c4,6,$12);
  528.               end;
  529.      __tseng3:begin
  530.                 vio(md);
  531.                 modinx($3c4,4,2,2);
  532.               end;
  533.      __tseng4:case hi(md) of
  534.                 0:setmode:=safemode(md);
  535.                 1:if tsvio($10e0,lo(md)) then
  536.                   begin
  537.                     {Diamond SpeedStar 24 does not clear memory}
  538.                     for x:=0 to 15 do         {clear memory}
  539.                     begin
  540.                       setbank(x);
  541.                       mem[$a000:0]:=0;
  542.                       fillchar(mem[$a000:1],65535,0);
  543.                     end;
  544.                   end else setmode:=false;
  545.                 2:if tsvio($10f0,md shl 8+$ff) then
  546.                   begin
  547.                     outp($3bf,3);
  548.                     outp(crtc+4,$a0);   {enable Tseng 4000 Extensions}
  549.                     wrinx(crtc,$13,0);
  550.                     modinx(crtc,$3f,$80,$80);
  551.                {     outp(crtc+4,$29);
  552.                     outp($3bf,1);      do we need these ? }
  553.                     wrinx(crtc,$13,0);
  554.                     modinx(crtc,$3f,$80,$80);
  555.                   end else setmode:=false;
  556.                 3:if not tsvio($10f0,lo(md)) then setmode:=false;
  557.                 4:if tsvio($10f0,lo(md)) then
  558.                   begin
  559.                     dactocomm;
  560.                     x:=inp($3c6);
  561.                     outp($3c6,x or 64);  {set DAC to 64K colors}
  562.                     dactopel;
  563.                   end else setmode:=false;
  564.               end;
  565.          __s3:if md<$100 then setmode:=safemode(md)
  566.               else begin
  567.                 rp.bx:=md;
  568.                 vio($4f02);
  569.                 if rp.ax=$4f then
  570.                 begin
  571.                   if md<$200 then vesamodeinfo(md);
  572.                 end
  573.                 else setmode:=false;
  574.               end;
  575.       __p2000:begin
  576.                 setmode:=safemode(md);
  577.                 if memmode=_p64k then
  578.                 begin
  579.                   dactocomm;
  580.                   outp($3c6,$c0);
  581.                 end;
  582.          (*       if memmode=_p16m then
  583.                 begin            {This can trick a ATT20c492 into 24bit mode}
  584.                   dactocomm;
  585.                   outp($3c6,$e0);
  586.                   bytes:=1600;
  587.                   pixels:=530;
  588.                 end;  *)
  589.               end;
  590.   else setmode:=safemode(md)
  591.   end;
  592.   curbank:=$ffff;    {Set curbank invalid }
  593.   case memmode of
  594.   _pl2e,_pl4:planes:=2;
  595.     _pl16:planes:=4;
  596.   else planes:=1;
  597.   end;
  598.   for x:=1 to mm div 64 do
  599.   begin
  600.     setbank(x-1);
  601.     mem[$a000:$ffff]:=0;
  602.     fillchar(mem[$a000:0],$ffff,0);
  603.   end;
  604.   modinx($3c4,4,2,2);    {Set "more than 64K" flag}
  605.   vseg:=$a000;
  606. end;
  607.  
  608. procedure checkmem(mx:word);
  609. var
  610.   fail:boolean;
  611.   ma:array[0..99] of byte;
  612.   x:word;
  613. begin
  614.   memmode:=_p256;
  615.  
  616.   fail:=true;
  617.   while (mx>1) and fail do
  618.   begin
  619.     setbank(mx-1);
  620.     move(mem[$a000:0],ma,100);
  621.     for x:=0 to 99 do
  622.       mem[$a000:x]:=ma[x] xor $aa;
  623.     setbank(mx-1);
  624.     fail:=false;
  625.     for x:=0 to 99 do
  626.       if mem[$a000:x]<>ma[x] xor $aa then fail:=true;
  627.     move(ma,mem[$a000:0],100);
  628.     if not fail then
  629.     begin
  630.       setbank((mx shr 1)-1);
  631.       for x:=0 to 99 do
  632.         mem[$a000:x]:=ma[x] xor $55;
  633.       setbank(mx-1);
  634.       fail:=true;
  635.       for x:=0 to 99 do
  636.         if mem[$a000:x]<>ma[x] xor $55 then fail:=false;
  637.       move(ma,mem[$a000:0],100);
  638.     end;
  639.     mx:=mx shr 1;
  640.   end;
  641.   mm:=mx*128;
  642. end;
  643.  
  644.  
  645. procedure setvstart(l:longint);       {Set the display start address}
  646. var x,y:word;
  647. begin
  648.   if chip<>__vesa then
  649.   begin
  650.     x:=l shr 2;
  651.     y:=(l shr 18) and (pred(mm) shr 8);   {Mask out any "too" high bits}
  652.     wrinx(crtc,13,lo(x));
  653.     wrinx(crtc,12,hi(x));
  654.   end;
  655.   case chip of
  656.     __tseng3:modinx(crtc,$23,2,y shl 1);
  657.     __tseng4:modinx(crtc,$33,3,y);
  658.     __tridcs:modinx(crtc,$1e,32,y shl 5);
  659.     __trid89:begin
  660.                modinx(crtc,$1e,$a0,y shl 5+128);
  661.                wrinx($3c4,11,0);
  662.                modinx($3c4,$e,1,y shr 1);
  663.              end;
  664.     __video7:modinx($3c4,$f6,$70,(y shl 4) and $30);
  665.   __paradise:modinx($3ce,$d,$18,y shl 3);
  666.   __chips452,__chips453:
  667.              begin
  668.                wrinx($3d6,12,y);
  669.                modinx($3d6,4,4,4);
  670.              end;
  671.      __ncr:begin
  672.              modinx(crtc,$31,$f,y);
  673.            end;
  674.     __ati1:modinx(atireg,$b0,$40,y shl 6);
  675.     __ati2:modinx(atireg,$b0,$c0,y shl 6);
  676.   __aheadb:modinx($3ce,$1c,3,y);
  677.     __vesa:begin
  678.              rp.bx:=0;
  679.              rp.cx:=l mod 320;
  680.              rp.dx:=l div 320;
  681.              vio($4f07);
  682.              if rp.ax=0 then;
  683.            end;
  684.       __s3:begin
  685.              wrinx(crtc,$38,$48);
  686.              modinx(crtc,$31,$30,y shl 4);
  687.              wrinx(crtc,$38,0);
  688.            end;
  689. __cirrus54:begin
  690.              if y>1 then inc(y,2);
  691.              modinx(crtc,$1b,5,y);
  692.            end;
  693.    __p2000:modinx($3ce,$21,$7,y);
  694.   end;
  695. end;
  696.  
  697.  
  698. procedure UNK(chp:string;id:word);
  699. begin
  700.   name:='Unknown '+chp+' chip ('+istr(id)+')';
  701. end;
  702.  
  703.    (*  Tests for various adapters  *)
  704.  
  705.  
  706. function _chipstech:boolean;
  707. begin
  708.   _chipstech:=false;
  709.   if dotest[__CHIPS451] then
  710.   begin
  711.     vio($5f00);
  712.     if rp.al=$5f then
  713.     begin
  714.       _chipstech:=true;
  715.       case rp.bl shr 4 of
  716.         0:name:='Chips & Tech 82c451';
  717.         1:name:='Chips & Tech 82c452';
  718.         2:name:='Chips & Tech 82c455';
  719.         3:name:='Chips & Tech 82c453';
  720.         5:name:='Chips & Tech 82c456';
  721.         6:name:='Chips & Tech 82c457';
  722.         7:name:='Chips & Tech F65520';
  723.         8:name:='Chips & Tech F65530';
  724.       else UNK('Chips & Tech',rp.bl shr 4);
  725.       end;
  726.       case rp.bl shr 4 of
  727.         1:CHIP:=__chips452;
  728.         3:CHIP:=__chips453;
  729.       else chip:=__chips451;
  730.       end;
  731.       case rp.bh of
  732.         1:mm:=512;
  733.         2:mm:=1024;
  734.       end;
  735.     end;
  736.   end;
  737. end;
  738.  
  739. function _paradise:boolean;
  740. var old,old1,old2:word;
  741. begin
  742.   _paradise:=false;
  743.   if dotest[__PARADISE] then
  744.   begin
  745.     old:=rdinx($3ce,15);
  746.     modinx($3ce,15,$17,0);   {Lock registers}
  747.  
  748.     if not testinx2($3ce,9,$7f) then
  749.     begin
  750.       wrinx($3ce,15,5);      {Unlock them again}
  751.       if testinx2($3ce,9,$7f) then
  752.       begin
  753.         _paradise:=true;
  754.         old2:=rdinx(crtc,$29);
  755.         name:='Paradise ';
  756.         modinx(crtc,$29,$8f,$85);   {Unlock WD90Cxx registers}
  757.         if not testinx(crtc,$2b) then name:=name+'PVGA1A'
  758.         else begin
  759.           old1:=rdinx($3c4,6);
  760.           wrinx($3c4,6,$48);
  761.           if not testinx2($3c4,7,$f0) then name:=name+'WD90C00'
  762.           else if not testinx($3c4,16) then
  763.           begin
  764.             name:=name+'WD90C2x';
  765.             wrinx(crtc,$34,$a6);
  766.             if (rdinx(crtc,$32) and 32)<>0 then wrinx(crtc,$34,0);
  767.           end
  768.           else if testinx2($3c4,20,15) then
  769.                begin
  770.                  if rdinx(crtc,$37)=$31 then name:=name+'WD90C31'
  771.                                         else name:=name+'WD90C30';
  772.                end
  773.                else if not testinx2($3c4,16,4) then name:=name+'WD90C10'
  774.                                                else name:=name+'WD90C11';
  775.  
  776.           wrinx($3c4,6,old1);
  777.         end;
  778.         case rdinx($3ce,11) shr 6 of
  779.            2:mm:=512;
  780.            3:mm:=1024;
  781.         end;
  782.         wrinx(crtc,$29,old2);
  783.         chip:=__paradise;
  784.       end;
  785.     end;
  786.     wrinx($3ce,15,old);
  787.   end;
  788. end;
  789.  
  790. function _video7:boolean;
  791. begin
  792.   _video7:=false;
  793.   if dotest[__video7] then
  794.   begin
  795.     vio($6f00);
  796.     if rp.bx=$5637 then
  797.     begin
  798.       _video7:=true;
  799.       vio($6f07);
  800.       case rp.bl of
  801.         $80..$ff:name:='Video7 VEGA VGA';
  802.         $70..$7f:name:='Video7 FASTWRITE/VRAM';
  803.         $50..$5f:name:='Video7 Version 5';
  804.         $41..$4f:name:='Video7 1024i';
  805.       end;
  806.       case rp.ah and 127 of
  807.         2:mm:=512;
  808.         4:mm:=1024;
  809.       end;
  810.       chip:=__video7;
  811.     end
  812.   end;
  813. end;
  814.  
  815. function _genoa:boolean;
  816. var ad:word;
  817. begin
  818.   _genoa:=false;
  819.   if dotest[__genoa] then
  820.   begin
  821.     ad:=memw[biosseg:$37];
  822.     if (memw[biosseg:ad+2]=$6699) and (mem[biosseg:ad]=$77) then
  823.     begin
  824.       _genoa:=true;
  825.       case mem[biosseg:ad+1] of
  826.         0:name:='Genoa 62/300';
  827.       $11:begin
  828.             name:='Genoa 64/500';
  829.             mm:=512;
  830.           end;
  831.       $22:name:='Genoa 6100';
  832.       $33:name:='Genoa 51/5200 (Tseng 3000)';
  833.       $55:begin
  834.             name:='Genoa 53/5400 (Tseng 3000)';
  835.             mm:=512;
  836.           end;
  837.       end;
  838.       if mem[biosseg:ad+1]<$33 then chip:=__genoa else chip:=__tseng3;
  839.     end
  840.   end;
  841. end;
  842.  
  843. function _tseng:boolean;
  844. var x,vs:word;
  845. begin
  846.   _tseng:=false;
  847.   if dotest[__TSENG3] or dotest[__TSENG4] then
  848.   begin
  849.     outp($3bf,3);
  850.     outp($3d8,$a0);    {Enable Tseng 4000 extensions}
  851.     if tstrg($3cd,$3f) then
  852.     begin
  853.       _tseng:=true;
  854.       if testinx2(crtc,$33,$f) then
  855.       begin
  856.         name:='Tseng ET4000';
  857.         case rdinx(crtc,$37) and 11 of
  858.          3,9:mm:=256;
  859.           10:mm:=512;
  860.           11:mm:=1024;
  861.         end;
  862.     (*    vio($10f1);
  863.         if (rp.ax=$10) then
  864.           case rp.bl of
  865.             1:name:=name+' /w Sierra RAMDAC';
  866.             2:name:=name+' /w SS24 RAMDAC';
  867.           end; *)
  868.         chip:=__tseng4;
  869.       end
  870.       else begin
  871.         name:='Tseng ET3000';
  872.         chip:=__tseng3;
  873.         if setmode($13) then;
  874.         x:=port[$3da];
  875.         x:=rdinx($3c0,$36);
  876.         port[$3c0]:=x or 16;
  877.         case (rdinx($3ce,6) shr 2) and 3 of
  878.          0,1:vs:=$a000;
  879.            2:vs:=$b000;
  880.            3:vs:=$b800;
  881.         end;
  882.  
  883.         meml[vs:1]:=$12345678;
  884.         if memw[vs:2]=$3456 then mm:=512;
  885.  
  886.         wrinx($3c0,$36,x);     {reset value and reenable DAC}
  887.       end;
  888.     end;
  889.   end;
  890. end;
  891.  
  892. function _trident:boolean;
  893. var chp,old,val:word;
  894. begin
  895.   _trident:=false;
  896.   if dotest[__tridBR] or dotest[__trid89] or dotest[__tridCS] then
  897.   begin
  898.     wrinx($3c4,11,0);
  899.     chp:=inp($3c5);
  900.     old:=rdinx($3c4,14);
  901.     outp($3c5,0);
  902.     val:=inp($3c5);
  903.     outp($3c5,old);
  904.     if (val and 15)=2 then
  905.     begin
  906.       _trident:=true;
  907.       case chp of
  908.         1:name:='Trident 8800BR';
  909.         2:name:='Trident 8800CS';
  910.         3:name:='Trident 8900';
  911.         4:name:='Trident 8900C';
  912.       $13:name:='Trident 8900C';
  913.       $23:name:='Trident 9000';
  914.       $83:name:='Trident LX9200';
  915.       $93:name:='Trident LCD9100';
  916.       else UNK('Trident',chp);
  917.       end;
  918.       case chp and 15 of
  919.         1:chip:=__tridbr;
  920.         2:chip:=__tridCS;
  921.         3:chip:=__trid89;
  922.       end;
  923.       if (pos('Zymos Poach 51',getbios(0,255))>0) or
  924.          (pos('Zymos Poach 51',getbios(230,255))>0) then
  925.       begin
  926.         name:=name+' (Zymos Poach)';
  927.         chip:=__poach;
  928.       end;
  929.       if (chp>=3) then
  930.       begin
  931.         case rdinx(crtc,$1f) and 3 of
  932.           0:mm:=256;
  933.           1:mm:=512;
  934.           2:mm:=768;
  935.           3:mm:=1024;
  936.         end;
  937.       end
  938.       else
  939.       if (rdinx(crtc,$1f) and 2)>0 then mm:=512;
  940.  
  941.     end;
  942.   end;
  943. end;
  944.  
  945. function _oak:boolean;
  946. begin
  947.   _oak:=false;
  948.   if dotest[__oak] then
  949.   begin
  950.     if testinx2($3de,$d,$38) then
  951.     begin
  952.       _oak:=true;
  953.       name:='OAK 037C';
  954.       if testinx($3DE,$11) then
  955.       begin
  956.         if rdinx($3DE,$B)=5 then name:='OAK 077'
  957.                             else name:='OAK 067';
  958.       end;
  959.       case rdinx($3de,13) shr 6 of
  960.         2:mm:=512;
  961.       1,3:mm:=1024;    {1 might not give 1M??}
  962.       end;
  963.       chip:=__oak;
  964.     end;
  965.   end;
  966. end;
  967.  
  968. function _cirrus:boolean;
  969. var old,eagle:word;
  970. begin
  971.   _cirrus:=false;
  972.   if dotest[__cirrus] then
  973.   begin
  974.     old:=rdinx(crtc,12);
  975.     outp(crtc+1,0);
  976.     eagle:=rdinx(crtc,$1f);
  977.     wrinx($3c4,6,lo(eagle shr 4) or lo(eagle shl 4));
  978.     if inp($3c5)=0 then
  979.     begin
  980.       outp($3c5,eagle);
  981.       if inp($3c5)=1 then
  982.       begin
  983.         _cirrus:=true;
  984.         case eagle of
  985.           $EC:name:='Cirrus 510/520';
  986.           $CA:name:='Cirrus 610/620';
  987.           $EA:name:='Cirrus Video 7 OEM'
  988.         else UNK('Cirrus',eagle);
  989.         end;
  990.         chip:=__cirrus;
  991.       end;
  992.     end;
  993.     wrinx(crtc,12,old);
  994.   end;
  995. end;
  996.  
  997.  
  998. function _cirrus54:boolean;
  999. var x,old:word;
  1000. begin
  1001.   _cirrus54:=false;
  1002.   if dotest[__cirrus54] then
  1003.   begin
  1004.     old:=rdinx($3C4,6);
  1005.     wrinx($3c4,6,$12);
  1006.     if (rdinx($3C4,6)=$12) and testinx2($3C4,$1E,$3F) and testinx2(crtc,$1B,$ff) then
  1007.     begin
  1008.       x:=rdinx(crtc,$27);
  1009.       case x of
  1010.           $8A:name:='Cirrus 54xx typ 2';
  1011.      $8C..$8F:name:='Cirrus 54xx typ 3';
  1012.      $90..$93:name:='Cirrus 54xx typ 5';
  1013.      $94..$97:name:='Cirrus 54xx typ 4';
  1014.       else UNK('Cirrus54',x);
  1015.       end;
  1016.       case rdinx($3C4,$F) and $18 of
  1017.         0:mm:=0;
  1018.         8:mm:=512;
  1019.        16:mm:=1024;
  1020.       end;
  1021.       _cirrus54:=true;
  1022.       chip:=__cirrus54;
  1023.     end
  1024.     else wrinx($3C4,6,old);
  1025.   end;
  1026. end;
  1027.  
  1028. function _ahead:boolean;
  1029. var old:word;
  1030. begin
  1031.   _ahead:=false;
  1032.   if dotest[__aheadA] or dotest[__aheadB] then
  1033.   begin
  1034.     old:=rdinx($3ce,15);
  1035.     wrinx($3ce,15,0);
  1036.     if not testinx2($3ce,12,$FB) then
  1037.     begin
  1038.       wrinx($3ce,15,$20);
  1039.       if testinx2($3ce,12,$FB) then
  1040.       begin
  1041.         _ahead:=true;
  1042.         case rdinx($3ce,15) and 15 of
  1043.           0:begin
  1044.               name:='Ahead A';
  1045.               chip:=__aheadA;
  1046.             end;
  1047.           1:begin
  1048.               name:='Ahead B';
  1049.               chip:=__aheadB;
  1050.             end;
  1051.         end;
  1052.       end;
  1053.     end;
  1054.     wrinx($3ce,15,old);
  1055.   end;
  1056. end;
  1057.  
  1058. function _everex:boolean;
  1059. var x:word;
  1060. begin
  1061.   _everex:=false;
  1062.   if dotest[__everex] then
  1063.   begin
  1064.     rp.bx:=0;
  1065.     vio($7000);
  1066.     if rp.al=$70 then
  1067.     begin
  1068.       x:=rp.dx shr 4;
  1069.       if  (x<>$678) and (x<>$236)
  1070.       and (x<>$620) and (x<>$673) then     {Some Everex boards use Trident chips.}
  1071.       begin
  1072.         _everex:=true;
  1073.         case rp.ch shr 6 of
  1074.           0:mm:=256;
  1075.           1:mm:=512;
  1076.           2:mm:=1024;
  1077.           3:mm:=2048;
  1078.         end;
  1079.         name:='Everex Ev'+hx[x shr 8]+hx[(x shr 4) and 15]+hx[x and 15];
  1080.         chip:=__everex;
  1081.       end;
  1082.     end;
  1083.   end;
  1084. end;
  1085.  
  1086. function _ati:boolean;
  1087. var w:word;
  1088. begin
  1089.   _ati:=false;
  1090.   if dotest[__ATI1] or dotest[__ati2] then
  1091.   begin
  1092.     if getbios($31,9)='761295520' then
  1093.     begin
  1094.       _ati:=true;
  1095.       case memw[biosseg:$40] of
  1096.        $3133:begin
  1097.                atireg:=memw[biosseg:$10];
  1098.                name:='ATI VGA Wonder';
  1099.                w:=rdinx(atireg,$bb);
  1100.                case w and 15 of
  1101.                  0:_crt:='EGA';
  1102.                  1:_crt:='Analog Monochrome';
  1103.                  2:_crt:='Monochrome';
  1104.                  3:_crt:='Analog Color';
  1105.                  4:_crt:='CGA';
  1106.                  6:_crt:='';
  1107.                  7:_crt:='IBM 8514/A';
  1108.                else _crt:='Multisync';
  1109.                end;
  1110.                chip:=__ati2;
  1111.                case chr(mem[biosseg:$43]) of
  1112.                 '1':begin
  1113.                       name:=name+' (18800)';
  1114.                       chip:=__ati1;
  1115.                     end;
  1116.                 '2':name:=name+' (18800-1)';
  1117.                 '3':name:=name+' (28800-2)';
  1118.                 '4':name:=name+' (28800-4)';
  1119.                 '5':begin
  1120.                       name:=name+' (28800-5)';
  1121.                       if (mem[biosseg:$44] and 128)<>0 then
  1122.                         name:=name+' /w HICOLOR DAC';
  1123.                     end;
  1124.                end;
  1125.                case chr(mem[biosseg:$43]) of
  1126.                  '1','2':if (rdinx(atireg,$bb) and 32)<>0 then mm:=512;
  1127.                      '3':if (rdinx(atireg,$b0) and 16)<>0 then mm:=512;
  1128.                  '4','5':case rdinx(atireg,$b0) and $18 of
  1129.                              0:mm:=256;
  1130.                            $10:mm:=512;
  1131.                          8,$18:mm:=1024;
  1132.                          end;
  1133.                end;
  1134.              end;
  1135.        $3233:begin
  1136.                name:='ATI EGA Wonder';
  1137.                video:='EGA';
  1138.                chip:=__ega;
  1139.              end;
  1140.       end;
  1141.     end;
  1142.   end;
  1143. end;
  1144.  
  1145. function _s3:boolean;
  1146. var x:word;
  1147. begin
  1148.   _s3:=false;
  1149.   if dotest[__s3] then
  1150.   begin
  1151.     wrinx(crtc,$38,0);
  1152.     if not testinx2(crtc,$35,$f) then
  1153.     begin
  1154.       wrinx(crtc,$38,$48);
  1155.       if testinx2(crtc,$35,$f) then
  1156.       begin
  1157.         _s3:=true;
  1158.         chip:=__s3;
  1159.         x:=rdinx(crtc,$30);
  1160.         case x of
  1161.           $81:name:='S3 86c911';
  1162.           $82:name:='S3 86c911A';  {Whats the diff?}
  1163.         else UNK('S3',x);
  1164.         end;
  1165.         if (rdinx(crtc,$41) and $10)<>0 then mm:=1024
  1166.                                         else mm:=512;
  1167.       end;
  1168.     end;
  1169.   end;
  1170. end;
  1171.  
  1172. function _al2101:boolean;
  1173. begin
  1174.   _al2101:=false;
  1175.   if dotest[__al2101] then
  1176.   begin
  1177.     if tstrg($8286,$ff) and testinx2(crtc,$1f,$3b)
  1178.        and testinx2($3ce,13,15) then
  1179.     begin
  1180.       _al2101:=true;
  1181.       name:='Avance Logic 2101';
  1182.       chip:=__al2101;
  1183.       case rdinx(crtc,$1e) and 3 of
  1184.         0:mm:=256;
  1185.         1:mm:=512;
  1186.         2:mm:=1024;
  1187.         3:mm:=2048;
  1188.       end;
  1189.     end;
  1190.   end;
  1191. end;
  1192.  
  1193. function _vesa:boolean;
  1194. begin
  1195.   _vesa:=false;
  1196.   if dotest[__vesa] then
  1197.   begin
  1198.     vio($4f03);
  1199.     if rp.al=$4f then
  1200.     begin
  1201.       _vesa:=true;
  1202.       name:='VESA';
  1203.       chip:=__vesa;
  1204.       vesa:=1;
  1205.     end;
  1206.   end;
  1207. end;
  1208.  
  1209. function _yamaha:boolean;
  1210. begin
  1211.   _yamaha:=false;
  1212.   if dotest[__yamaha] then
  1213.   begin
  1214.     if testinx2($3d4,$7c,$7c) then
  1215.     begin
  1216.       _yamaha:=true;
  1217.       name:='Yamaha 6388'
  1218.     end;
  1219.   end;
  1220. end;
  1221.  
  1222. function _ncr:boolean;
  1223. var x:word;
  1224. begin
  1225.   _ncr:=false;
  1226.   if dotest[__ncr] then
  1227.   begin
  1228.     if testinx2($3c4,5,5) then
  1229.     begin
  1230.       wrinx($3c4,5,0);        {Disable extended registers}
  1231.       if not testinx2($3c4,16,$ff) then
  1232.       begin
  1233.         wrinx($3c4,5,1);        {Enable extended registers}
  1234.         if testinx2($3c4,16,$ff) then
  1235.         begin
  1236.           _ncr:=true;
  1237.           chip:=__ncr;
  1238.           x:=rdinx($3c4,8) shr 4;
  1239.           case x of
  1240.             0:name:='NCR 77C22';
  1241.             1:name:='NCR 77C21';
  1242.             2:name:='NCR 77C22E';
  1243.         8..15:name:='NCR 77C22E+';
  1244.           else UNK('NCR',x);
  1245.           end;
  1246.           name:=name+' Rev. '+istr(rdinx($3c4,8) and 15);
  1247.           if setmode($13) then;
  1248.           checkmem(64);
  1249.         end;
  1250.       end;
  1251.     end;
  1252.   end;
  1253. end;
  1254.  
  1255. function _acumos:boolean;
  1256. var old:word;
  1257. begin
  1258.   _acumos:=false;
  1259.   if dotest[__acumos] then
  1260.   begin
  1261.     old:=rdinx($3c4,6);
  1262.   {  wrinx($3c4,6,0);
  1263.     if not testinx2($3ce,9,$f0) then }
  1264.     begin
  1265.       wrinx($3c4,6,$12);
  1266.       if testinx2($3ce,9,$30) then
  1267.       begin
  1268.         _acumos:=true;
  1269.         name:='Acumos AVGA2';
  1270.         chip:=__acumos;
  1271.         case rdinx($3c4,$a) and 3 of
  1272.           0:mm:=256;
  1273.           1:mm:=512;
  1274.           2:mm:=1024;
  1275.         end;
  1276.       end;
  1277.     end;
  1278.     wrinx($3c4,6,old);
  1279.   end;
  1280. end;
  1281.  
  1282. function _mxic:boolean;
  1283. begin
  1284.   _mxic:=false;
  1285.   if dotest[__mxic] then
  1286.   begin
  1287.     old:=rdinx($3c4,$a7);
  1288.     wrinx($3c4,$a7,0);       {disable extensions}
  1289.     if not testinx($3c4,$c5) then
  1290.     begin
  1291.       wrinx($3c4,$a7,$87);   {enable extensions}
  1292.       if testinx($3c4,$c5) then
  1293.       begin
  1294.         _mxic:=true;
  1295.         chip:=__mxic;
  1296.         name:='MX 86010';
  1297.         case (rdinx($3c4,$c2)  shr 2) and 3 of
  1298.           0:mm:=256;
  1299.           1:mm:=512;
  1300.           2:mm:=1024;
  1301.         end;
  1302.       end;
  1303.     end;
  1304.     wrinx($3c4,$a7,old);
  1305.   end;
  1306. end;
  1307.  
  1308. function _p2000:boolean;
  1309. begin
  1310.   _p2000:=false;
  1311.   if dotest[__p2000] then
  1312.   begin
  1313.     if testinx2($3CE,$3d,$3f) and tstrg($3d6,$1f) and tstrg($3d7,$1f) then
  1314.     begin
  1315.       _p2000:=true;
  1316.       name:='Primus P2000';
  1317.       chip:=__p2000;
  1318.       if setmode($13) then;
  1319.       checkmem(32);
  1320.     end;
  1321.   end;
  1322. end;
  1323.  
  1324. function _realtek:boolean;
  1325. var x:word;
  1326. begin
  1327.   _realtek:=false;
  1328.   if dotest[__realtek] then
  1329.   begin
  1330.     if testinx2(crtc,$1f,$3f) and tstrg($3d6,$f) and tstrg($3d7,$f) then
  1331.     begin
  1332.       chip:=__realtek;
  1333.       name:='Realtek';
  1334.       _realtek:=true;
  1335.       x:=rdinx(crtc,$1a) shr 6;
  1336.       case x of
  1337.      0..2:name:='Realtek version '+istr(x);
  1338.       else UNK('Realtek',x);
  1339.       end;
  1340.       case rdinx(crtc,$1e) and 15 of
  1341.         0:mm:=256;
  1342.         1:mm:=512;
  1343.         2:if x=0 then mm:=768  else mm:=1024;
  1344.         3:if x=0 then mm:=1024 else mm:=2048;
  1345.       end;
  1346.     end;
  1347.   end;
  1348. end;
  1349.  
  1350.  
  1351.  
  1352. function testdac:string;      {Test for type of DAC}
  1353. var
  1354.   x,y,z,v,oldcommreg,oldpelreg:word;
  1355.  
  1356. begin
  1357.   IF chip=__al2101 then    (* Special case -- weird DAC *)
  1358.   begin
  1359.     dactype:=_dac16;
  1360.     testdac:='AVL DAC 16';
  1361.     exit;
  1362.   end;
  1363.   testdac:='Normal';
  1364.   dactype:=_dac8;
  1365.   dactopel;
  1366.   x:=inp($3c6);
  1367.   repeat
  1368.     y:=x;         {wait for the same value twice}
  1369.     x:=inp($3c6);
  1370.   until (x=y);
  1371.   z:=x;
  1372.   dactocomm;
  1373.   if daccomm<>$8e then
  1374.   begin                      {If command register=$8e, we've got an SS24}
  1375.     y:=8;
  1376.     repeat
  1377.       x:=inp($3c6);
  1378.       dec(y);
  1379.     until (x=$8e) or (y=0);
  1380.   end
  1381.   else x:=daccomm;
  1382.   if x=$8e then
  1383.   begin
  1384.     dactype:=_dacss24;
  1385.     testdac:='SS24';
  1386.     dactopel;
  1387.   end
  1388.   else begin
  1389.  
  1390.     dactocomm;
  1391.     oldcommreg:=inp($3c6);
  1392.     dactopel;
  1393.     oldpelreg:=inp($3c6);
  1394.     x:=oldcommreg xor 255;
  1395.     outp($3c6,x);
  1396.     dactocomm;
  1397.     v:=inp($3c6);
  1398.     if v<>x then
  1399.     begin
  1400.       dactocomm;
  1401.       x:=oldcommreg xor $60;
  1402.       outp($3c6,x);
  1403.       dactocomm;
  1404.       v:=inp($3c6);
  1405.       testdac:='Sierra SC11486';
  1406.       dactype:=_dac15;
  1407.  
  1408.       if (x and $e0)=(v and $e0) then
  1409.       begin
  1410.         x:=inp($3c6);
  1411.         dactopel;
  1412.         testdac:='Sierra 32k/64k';
  1413.         dactype:=_dac15;             (* Can't tell the difference *)
  1414.  
  1415.         if x=inp($3c6) then
  1416.         begin
  1417.           testdac:='ATT 20c491/2';
  1418.           dactype:=_dacatt;
  1419.           dactocomm;
  1420.           outp($3c6,255);
  1421.           dactocomm;
  1422.           x:=inp($3c6);
  1423.           if x<>255 then
  1424.           begin
  1425.             testdac:='Acumos ADAC';
  1426.             dactype:=_dacadac1;
  1427.           end;
  1428.         end;
  1429.       end;
  1430.  
  1431.       dactocomm;
  1432.       outp($3c6,oldcommreg);
  1433.     end;
  1434.     dactopel;
  1435.     outp($3c6,oldpelreg);
  1436.   end;
  1437. end;
  1438.  
  1439.  
  1440. procedure findbios;     {Finds the most likely BIOS segment}
  1441. var
  1442.   score:array[0..7] of byte;
  1443.   x,y:word;
  1444. begin
  1445.   biosseg:=$c000;
  1446.   for x:=0 to 6 do score[x]:=1;
  1447.   for x:=0 to 7 do
  1448.   begin
  1449.     rp.bh:=x;
  1450.     vio($1130);
  1451.     if (rp.es>=$c000) and ((rp.es and $7ff)=0) then
  1452.       inc(score[(rp.es-$c000) shr 11]);
  1453.   end;
  1454.  
  1455.   for x:=0 to 6 do
  1456.   begin
  1457.     y:=$c000+(x shl 11);
  1458.     if (memw[y:0]<>$aa55) or (mem[y:2]<48) then
  1459.       score[x]:=0;                       {fail if no rom}
  1460.   end;
  1461.   for x:=6 downto 0 do
  1462.     if score[x]>0 then
  1463.       biosseg:=$c000+(x shl 11);
  1464. end;
  1465.  
  1466.  
  1467. procedure findvideo;
  1468. begin
  1469.   dactype:=_dac0;
  1470.   extra:='';
  1471.   _crt:='';
  1472.   chip:=__none;
  1473.   secondary:='';
  1474.   name:='';
  1475.   video:='none';
  1476.   rp.ah:=18;
  1477.   rp.bx:=$1010;
  1478.   intr(16,rp);
  1479.   if rp.bh<=1 then
  1480.   begin
  1481.     video:='EGA';
  1482.     chip:=__ega;
  1483.     if odd(inp($3cc)) then crtc:=$3d4
  1484.                       else crtc:=$3b4;
  1485.  
  1486.     mm:=rp.bl;
  1487.     vio($1a00);
  1488.     if rp.al=$1a then
  1489.     begin
  1490.       if (rp.bl<4) and (rp.bh>3) then
  1491.       begin
  1492.         old:=rp.bl;
  1493.         rp.bl:=rp.bh;
  1494.         rp.bh:=old;
  1495.       end;
  1496.       video:='MCGA';
  1497.       case rp.bl of
  1498.         2,4,6,10:_crt:='TTL Color';
  1499.         1,5,7,11:_crt:='Monochrome';
  1500.         8,12:_crt:='Analog Color';
  1501.       end;
  1502.       case rp.bh of
  1503.         1:secondary:='Monochrome';
  1504.         2:secondary:='CGA';
  1505.       end;
  1506.       findbios;
  1507.       if (getbios($31,9)='') and (getbios($40,2)='22') then
  1508.       begin
  1509.         video:='EGA';       {@#%@  lying ATI EGA Wonder !}
  1510.         name:='ATI EGA Wonder';
  1511.  
  1512.       end else
  1513.       if (rp.bl<10) or (rp.bl>12) then
  1514.       begin
  1515.         video:='VGA';
  1516.         chip:=__vga;
  1517.         mm:=256;
  1518.         if _vesa then extra:=extra+'VESA ';
  1519.         if _chipstech then
  1520.         else if _paradise then
  1521.         else if _video7 then
  1522.         else if _genoa then
  1523.         else if _everex then
  1524.         else if _trident then
  1525.         else if _ati then
  1526.         else if _ahead then
  1527.         else if _ncr then
  1528.         else if _s3 then
  1529.         else if _al2101 then
  1530.         else if _mxic then
  1531.         else if _cirrus54 then
  1532.         else if _acumos then
  1533.         else if _tseng then
  1534.         else if _realtek then
  1535.         else if _p2000 then
  1536.         else if _yamaha then
  1537.         else if _oak then
  1538.         else if _cirrus then;
  1539.  
  1540.         dacname:=testdac;
  1541.  
  1542.       end;
  1543.     end;
  1544.   end;
  1545. end;
  1546.  
  1547. begin
  1548. end.